home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / wind-test.scm < prev   
Text File  |  1995-10-13  |  1KB  |  53 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. "
  5. The correct output looks something like this:
  6.  
  7. wind-1  f: 1
  8. wind-2  f: 2
  9. before-throw-out  f: 3
  10. unwind-2  f: 2
  11. unwind-1  f: 1
  12. after-throw-out  f: top
  13. wind-1  f: 1
  14. wind-2  f: 2
  15. after-throw-in  f: 3
  16. unwind-2  f: 2
  17. unwind-1  f: 1
  18. done  f: top
  19. "
  20.  
  21. (define (wind-test)
  22.   (let* ((f (make-fluid 'top))
  23.      (report (lambda (foo)
  24.            (write foo)
  25.            (display "  f: ")
  26.            (write (fluid f))
  27.            (newline))))
  28.     ((call-with-current-continuation
  29.        (lambda (k1)
  30.      (let-fluid f 1
  31.        (lambda ()
  32.          (dynamic-wind
  33.           (lambda () (report 'wind-1))
  34.           (lambda ()
  35.         (let-fluid f 2
  36.           (lambda ()
  37.             (dynamic-wind
  38.              (lambda () (report 'wind-2))
  39.              (lambda ()
  40.                (let-fluid f 3
  41.              (lambda ()
  42.                (report 'before-throw-out)
  43.                (call-with-current-continuation
  44.                  (lambda (k2)
  45.                    (k1 (lambda ()
  46.                      (report 'after-throw-out)
  47.                      (k2 #f)))))
  48.                (report 'after-throw-in)
  49.                (lambda () (report 'done)))))
  50.              (lambda () (report 'unwind-2))))))
  51.           (lambda () (report 'unwind-1))))))))))
  52.  
  53.